home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / compuserve-file-archive / 05 Programming / MUDRIV.4TH < prev    next >
Text File  |  2019-04-13  |  4KB  |  172 lines
  1. scr #1 
  2.  0> .( blazin' forth 91 system loader ) cr
  3.  1> view? off  nomudrive forget thru
  4.  2> mount   offset off
  5.  3>       3 .( thru )          load cr
  6.  4> 141 147 .( multidrive )    thru cr
  7.  5>  24  30 .( assembler )     thru cr
  8.  6>   4  23 .( utilities )     thru cr
  9.  7>  31  49 .( editor )        thru cr
  10.  8>  50  57 .( strings )       thru cr
  11.  9>  58  70 .( sid support )   thru cr
  12. 10>  71 104 .( vic support )   thru cr
  13. 11>       2 .( disk config )   load cr
  14. 12> 2 view? ! .( locate enabled ) cr
  15. 13> mudrive dclose save-forth
  16. 14> 
  17. 15> 
  18.  
  19.  
  20. scr #2 
  21.  0> ( disk drive configuration )
  22.  1> mudrive   topblock off
  23.  2>     8  0  make1541  dr8
  24.  3> (   9  1  make1541  dr9  )
  25.  4>    10  1  make1581  dr10
  26.  5> (  11  3  make1581  dr11 )
  27.  6>   512  2  makereu   dram
  28.  7> 
  29.  8> 
  30.  9> 
  31. 10> 
  32. 11> 
  33. 12> 
  34. 13> 
  35. 14> 
  36. 15> 
  37.  
  38.  
  39. scr #141 
  40.  0> ( multidrive support      1 of 7 )
  41.  1> 5 constant #drv
  42.  2> variable curdrv  curdrv off
  43.  3> variable topblock  topblock off
  44.  4> create drvtbl  #drv 10 * allot
  45.  5> drvtbl #drv 10 * erase
  46.  6> 
  47.  7> : >drv  ( offset == ; -- addr )
  48.  8>     create c,   does>
  49.  9>     c@ swap 10 * drvtbl + + ;
  50. 10> 
  51. 11> 0 >drv 'drv-open
  52. 12> 2 >drv 'drv-r/w
  53. 13> 4 >drv drv-data
  54. 14> 6 >drv lowblk
  55. 15> 8 >drv highblk
  56.  
  57.  
  58. scr #142 
  59.  0> ( multidrive support      2 of 7 )
  60.  1> : blk-exists   ( scr# -- )
  61.  2>     dup 0<  swap topblock @ 1- > or
  62.  3>     abort" illegal screen number" ;
  63.  4> : off-drv?   ( scr# drv -- ? ) >r
  64.  5>     r@ lowblk @  over >
  65.  6>     r> highblk @ 1-  rot < or ;
  66.  7> : find-drv   ( scr# -- drv )   0
  67.  8>     begin  2dup off-drv?  while  1+  repeat
  68.  9>     swap drop ;
  69. 10> : set-drv   ( scr# -- )
  70. 11>     dup curdrv @ off-drv? 
  71. 12>     if  dup blk-exists
  72. 13>         dup find-drv  dup curdrv !
  73. 14>         'drv-open @ execute
  74. 15>     then  drop ;
  75.  
  76.  
  77. scr #143 
  78.  0> ( multidrive support      3 of 7 )
  79.  1> create rfil  hex 23 decimal c, ( #)
  80.  2> : drv-mount   ( -- )
  81.  3>     curdrv @ drv-data @
  82.  4>     13 close  15 close  15 2dup 0 0 (open) ioerr
  83.  5>  (  15 (cmdout) ( ioerr ." i0" cmdoff )
  84.  6>     13 swap over rfil 1 (open) ioerr  ?disc ;
  85.  7> : fixblk   ( addr scr# rwflag -- addr scr# rwflag )
  86.  8>   swap curdrv @ lowblk @ - swap ;
  87.  9> hex
  88. 10> : reu-open ;   ( to not used, leaves err chan open )
  89. 11> : reu-r/w   ( addr scr# rwflag -- )
  90. 12>     fixblk  >r  swap df02 !  8 /mod 0400 dup df07 ! *
  91. 13>     df04 !  df06 c!  df09 off
  92. 14>     r>  if  0fd  else  0fc  then  df01 c! ;
  93. 15> decimal
  94.  
  95.  
  96. scr #144 
  97.  0> ( multidrive support      4 of 7 )
  98.  1> : 1541-to   ( addr scr# rwflag --
  99.  2>                maxsecs addr sec trck drv rwflag )
  100.  3>     fixblk  to ;   ( heheh use original to )
  101.  4> 
  102.  5> : 1581-to   ( addr scr# rwflag --
  103.  6>                maxsecs addr sec trck drv rwflag )
  104.  7>     fixblk  >r 0 >r  dup 390 <
  105.  8>     if        40 1 >r
  106.  9>     else 380 - 40 40 >r
  107. 10>     then
  108. 11>     rot rot dup 2 mod swap over -
  109. 12>     2* 2* + 2 pick /mod r> + r> r> ;
  110. 13> defer to
  111. 14> : 1541-open   ['] 1541-to is to  drv-mount ;
  112. 15> : 1581-open   ['] 1581-to is to  drv-mount ;
  113.  
  114.  
  115. scr #145 
  116.  0> ( multidrive support      5 of 7 )
  117.  1> : 15xx-r/w   ( addr scr# flag -- )
  118.  2>     ?disc  to
  119.  3>     4 0 do  5 0 do  4 pick  loop
  120.  4>     >disc  if .derr then
  121.  5>     >r >r >r >r
  122.  6>     256 + r> 2+ 2 pick /mod r> + r> r> loop
  123.  7>     2drop 2drop 2drop ;
  124.  8> : read/write  ( addr scr# flag -- )
  125.  9>     over set-drv  curdrv @ 'drv-r/w @ execute ;
  126. 10> 
  127. 11> : mount   curdrv @ 'drv-open @ execute ;
  128. 12> : bcopy   ( from to how-many -- )
  129. 13>     over + swap do  i .
  130. 14>     dup block i buffer 1024 cmove
  131. 15>     update 1+ loop drop save-buffers ;
  132.  
  133.  
  134. scr #146 
  135.  0> ( multidrive support      6 of 7 )
  136.  1> : makedrv  ( 'open 'r/w siz data slot -- )
  137.  2>     >r  r@ drv-data !
  138.  3>     topblock @ r@ lowblk !
  139.  4>     topblock +!
  140.  5>     topblock @ r@ highblk !
  141.  6>     r@ 'drv-r/w !
  142.  7>     r@ 'drv-open !
  143.  8>     r> lowblk @  create , does> @ offset ! ;
  144.  9> : make1541   ( dev# slot -- ) >r >r
  145. 10>     ['] 1541-open  ['] 15xx-r/w  166 r> r> makedrv ;
  146. 11> : make1581   ( dev# slot -- ) >r >r
  147. 12>     ['] 1581-open  ['] 15xx-r/w  790 r> r> makedrv ;
  148. 13> : makereu   ( size slot -- ) >r
  149. 14>     ['] reu-open  ['] reu-r/w  rot  0 r> makedrv ;
  150. 15> 
  151.  
  152.  
  153. scr #147 
  154.  0> ( multidrive support      7 of 7 )
  155.  1> 
  156.  2> : mudrive  ['] read/write  ['] r/w >body ! ;
  157.  3> : nomudrive  ['] (r/w)  ['] r/w >body ! ;
  158.  4> ( make sure to invoke "nomudrive" before reloading! )
  159.  5> 
  160.  6> 
  161.  7> 
  162.  8> 
  163.  9> 
  164. 10> 
  165. 11> 
  166. 12> 
  167. 13> 
  168. 14> 
  169. 15> 
  170.  
  171.  
  172.